home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Video Toaster 4.0
/
Video Toaster v4.0.iso
/
arexx
/
modeler
/
pointspread.lwm
< prev
next >
Wrap
Text File
|
1993-12-13
|
5KB
|
192 lines
/* PointSpread.lwm -- Distribute particles in Modeler space. CMD: Point Distributions
* By Arnie Cachelin © 1992, 1993 NewTek Inc. */
libadd = addlib("LWModelerARexx.port",0)
signal on error
signal on syntax
Fn.0 = dist_RadialLinInc
Fn.1 = dist_RadialExpInc
Fn.2 = dist_RadialLinDec
Fn.3 = dist_RadialExpDec
Fn.4 = dist_Const
FnList.1='Linear'
FnList.2='Exponential'
FnList.3='Constant'
FnList.4='Custom'
CustFn=4
ufunc='sin(r*r)'
FList= FnList.1 FnList.2 FnList.3 FnList.4
RMax=1.0
rx=1; ry=1; rz=1
dist=1
shape=1
rate=1
grad=2
points=100
sysnam = 'Random Point Distribution'
filnam = 'ENV:PointSpread.state'
version = 'PointSpread v1.1'
check=1
RexxMathLib = "rexxmathlib.library"
Modeler= "LWModelerARexx.port"
L=SHOW('Libraries')
IF POS("LWModelerARexx.port" ,L ) = 0 THEN ADDLIB("LWModelerARexx.port",0)
call addlib "rexxsupport.library", 0, -30, 0
IF POS(RexxMathLib ,L) = 0 THEN check=ADDLIB(RexxMathLib , 0 , -30 , 0)
if ~check then do
call notify(1,"!Can't find rexxmathlib.library")
exit
end
if (exists(filnam)) then do
if (~open(state, filnam, 'R')) then break
if (readln(state) ~= version) then break
parse value readln(state) with points dist shape grad rate.
parse value readln(state) with rx ry rz
ufunc = readln(state)
call close state
end
Pi=3.14159265358
DegreesPerRadian= 180/pi
call randu(time('s')) /* Seed random number generator */
call req_begin sysnam
id_N = req_addcontrol("Number of Points", 'n', 1)
id_rad = req_addcontrol("Radius", 'v', 1)
id_Shape=req_addcontrol("Shape", 'CH','Round Square')
id_IncDec = req_addcontrol("Falloff Towards", 'CH','Center Edges')
id_Rate = req_addcontrol("Steepness", 'n')
id_Dist = req_addcontrol("Density Distribution", 'CH',FList)
id_fun = req_addcontrol("Custom Probability (0-1)", 's', 35)
call req_setval id_Dist,dist
call req_setval id_rad,rx ry rz,RMax
call req_setval id_N,points
call req_setval id_Rate,rate
call req_setval id_IncDec,grad
call req_setval id_fun, ufunc
call req_setval id_Shape, shape
if (~req_post()) then do
call req_end
exit
end
parse value req_getval(id_rad) with rx ry rz
RMax =(rx+ry+rz)/3
shape = req_getval(id_shape)
points = abs(req_getval(id_N)) % 1
Rate = req_getval(id_Rate)
Grad = 2*(req_getval(id_IncDec)-1)
fnid = req_getval(id_Dist)
i=fnid-1+Grad
if fnid=CustFn then do
func = req_getval(id_fun)
ufunc=func
end
else func = Fn.i'(r)'
if fn=CustFn-1 then func ='1'
if (open(state, filnam, 'W')) then do
call writeln state, version
call writeln state, points fnid shape grad rate.
call writeln state, rx ry rz
call writeln state, ufunc
call close state
end
call req_end
call add_begin
call meter_begin points+1, "Generating "points" Points", FnList.fnid" Distribution."
N=0
do i=1 to points
N=N+1
if(shape=1) then do
x=(2*randu()-1)*rx
y=(2*randu()-1)*ry
z=(2*randu()-1)*rz
r=Sphere_R(x,y,z)
interpret 'P='func
if(randu()<P) then do
call add_point x y z
call add_polygon i
call meter_step
end
else i=i-1
end
else do
x=(2*randu()-1)*rx
r=x
interpret 'P1='func
y=(2*randu()-1)*ry
r=y
interpret 'P2='func
z=(2*randu()-1)*rz
r=z
interpret 'P3='func
P=(P1+P2+P3)/3
if(randu()<P) then do
call add_point x y z
call add_polygon i
call meter_step
end
else i=i-1
end
end
call add_end
call notify(1,'!'version,"@Drew "i-1" points out of "N)
exit
syntax:
error:
call end_all
if (libadd) then call remlib("LWModelerARexx.port")
t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
exit
/* These functions return a probability based on position for various
particle distributions. This probability is used, Monte Carlo style,
to filter random positions generated above. This is an inefficient way
to do this, but it should be very general, and computers are meant to do
boring, repetitive tasks with brute force... aren't they?
*/
dist_Const: PROCEDURE EXPOSE RMax
arg r
if(r>RMax) then return 0
else return 1
dist_RadialLinDec: PROCEDURE EXPOSE RMax
arg r
if(r>RMax) then return 0
else return (RMax-r)/RMax
dist_RadialLinInc: PROCEDURE EXPOSE RMax
arg r
if(r>RMax) then return 0
else return r/RMax
dist_RadialExpDec: PROCEDURE EXPOSE Rate RMax
arg r
if(r>RMax) then return 0
else return exp(-Rate*r/RMax)
dist_RadialExpInc: PROCEDURE EXPOSE Rate RMax
arg x, y, z
if(r>RMax) then return 0
else return exp(-Rate*(r-RMax)/RMax)
/* Return R in Spherical coordinate system */
Sphere_R: PROCEDURE
arg x, y, z
return sqrt(x*x+y*y+z*z)